home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
qbnws105.zip
/
DB.ZIP
/
DB.BAS
Wrap
BASIC Source File
|
1988-01-25
|
9KB
|
199 lines
'+==============================================+
'| DB.BAS 1/25/88 |
'| David Perry |
'| QuickBASIC 4.0 Source |
'| Compile: BC DB /O/D |
'| Link: LINK /EX DB; |
'| Opens dBASE III .DBF and .DBT files |
'| Reads and displays structure .DBF file |
'| Then reads and displays data to include |
'| up to first 4000 bytes of memo fields |
'| This can be redirected to file or printer |
'| by typing DB FILENAME.DBF>FILEDAT or |
'| DB FILENAME.DBF>PRN |
'| Respects flag for deleted records (may |
'| be modified--see source below) |
'| This is a simple basis for building QB |
'| programs which require reading .DBF files |
'+==============================================+
DECLARE SUB Stripchar (a$)
REM $DYNAMIC
DEFINT A-Z
TYPE dBHeader
Version AS STRING * 1 'dBaseIII file header
Lastupdate AS STRING * 3 '32 bytes
NumRecs AS LONG
NumBytesHeader AS INTEGER
NumBytesRec AS INTEGER
Trash AS STRING * 20
END TYPE
TYPE FieldDescriptor 'Field Descriptions
FName AS STRING * 11 '32 bytes * Number of Fields
FType AS STRING * 1 ' Up to 128
DataAddress AS STRING * 4
Length AS STRING * 1
DecimalCount AS STRING * 1
Trash AS STRING * 14
END TYPE
CONST TRUE = -1: FALSE = NOT TRUE
DELETED = TRUE
DIM Header AS dBHeader, FieldDes AS FieldDescriptor 'Creating variables for user-defined types
DIM memo AS STRING * 512 'Create a 512 byte fixed string variable
' to read memo fields
IF COMMAND$ = "" THEN
PRINT "Please enter the name of a database file "; 'Parsing the command line
LINE INPUT dbasename$
IF dbasename$ = "" THEN END
ELSE
dbasename$ = COMMAND$
END IF
dbasename$ = UCASE$(dbasename$)
dot = INSTR(dbasename$, ".")
IF dot THEN
dbasename$ = LEFT$(dbasename$, dot - 1) + ".DBF"
ELSE
dbasename$ = dbasename$ + ".DBF"
END IF
OPEN dbasename$ FOR BINARY AS #1 'Binary file I/O
GET #1, , Header 'This reads in the first 32 bytes
SELECT CASE Header.Version
CASE CHR$(&H83) 'Be sure we're using a dBASE III file
dot = INSTR(dbasename$, ".")
dmemo$ = LEFT$(dbasename$, dot - 1) + ".DBT" 'Open a .DBT file if Header.Version=CHR(&H83)
OPEN dmemo$ FOR BINARY AS #2
CASE CHR$(&H3)
CASE ELSE
PRINT "This is not a dBASE III file"
END
END SELECT
Year = ASC(MID$(Header.Lastupdate, 1, 1)) 'Date of last update is stored in 3 bytes
Month = ASC(MID$(Header.Lastupdate, 2, 1)) 'The value of year,month,day = ASCII value of the
Day = ASC(MID$(Header.Lastupdate, 3, 1)) 'Bytes
NumFields = Header.NumBytesHeader \ 32 - 1 'Calculate the number of fields
REDIM FieldDes(1 TO NumFields) AS FieldDescriptor 'Create an array of Field Descriptors
PRINT "Structure for database: "; dbasename$
PRINT USING "\ \ ##########"; "Number of data records :"; Header.NumRecs
PRINT USING "\ \ ##/##/##"; "Date of last update :"; Month; Day; Year
PRINT "Field Field Name Type Width Dec"
FOR i = 1 TO (NumFields)
GET #1, (32 * i) + 1, FieldDes(i) 'Looping through NumFields by reading in 32 byte records
SELECT CASE FieldDes(i).FType 'Reading the dBASE Field Type
CASE "C"
PrintType$ = "Character"
CASE "D"
PrintType$ = "Date"
CASE "N"
PrintType$ = "Numeric"
CASE "L"
PrintType$ = "Logical"
CASE "M"
PrintType$ = "Memo"
END SELECT
'This prints out the field names, lengths, numeric, decimal values as appropriate
PRINT USING "##### \ \ \ \ ### ###"; i; FieldDes(i).FName; PrintType$; ASC(FieldDes(i).Length); ASC(FieldDes(i).DecimalCount)
NEXT i
'The field names, lengths, and types are read. Now read in the data
SEEK #1, Header.NumBytesHeader + 1 'Advance the file pointer to the beginning of the data section
FOR i = 1 TO Header.NumRecs 'Now loop through the number of records
Record$ = STRING$(Header.NumBytesRec, " ") 'Create a variable string length of length= record length
GET #1, , Record$ 'Read in the number of bytes in one record
Length = 2
FOR j = 1 TO NumFields 'Now display each field by extracting the correct number of
IF LEFT$(Record$, 1) = "*" AND DELETED THEN EXIT FOR 'The leftmost character in each record is ASCII &H2A if record is
' marked as deleted or &H20 if not deleted
' change to NOT DELETED to view all records, DELETED to view only
' non-deleted records
a$ = MID$(Record$, Length, ASC(FieldDes(j).Length)) 'Characters for each field
SELECT CASE FieldDes(j).FType 'Now assign the fields the correct type
CASE "D" 'Date
a$ = MID$(a$, 5, 2) + "/" + MID$(a$, 7, 2) + "/" + MID$(a$, 3, 2)
PRINT a$
CASE "C" 'Character
PRINT a$
CASE "N" 'Turn numeric fields into DOUBLE types
IF FieldDes(j).DecimalCount <> " " THEN
a# = VAL(a$) / 10 ^ VAL(FieldDes(j).DecimalCount)
ELSE
a# = VAL(a$)
END IF
PRINT a#
CASE "L" 'assign an integer to logical types
IF a$ = "T" OR a$ = "Y" THEN
a% = -1
ELSE
a% = 0
END IF
PRINT a%
CASE "M"
a& = VAL(a$) 'memo fields contain a pointer to the 512K block
IF a& > 0 THEN ' of text in the accompanying .DBT file
GET #2, (a& * 512 + 1), memo ' read in 512 bytes offset 512*pointer+1
a$ = memo
Escape = INSTR(a$, CHR$(&H1A) + CHR$(&H1A)) 'each .DBT record ends with &H1A&H1A
IF Escape THEN 'stop reading in the record if &H1A&H1A
a$ = LEFT$(a$, Escape - 1)
Stripchar a$
PRINT a$
ELSE 'else keep reading
done = FALSE
b$ = a$
a& = a& + 1
DO
GET #2, (a& * 512 + 1), memo
a$ = memo
Escape = INSTR(a$, CHR$(&H1A) + CHR$(&H1A))
IF Escape THEN
done = TRUE
a$ = LEFT$(a$, Escape - 1)
Stripchar a$
b$ = b$ + a$
PRINT b$
ELSE
Stripchar a$
b$ = b$ + a$
IF LEN(b$) > 4000 THEN done = TRUE 'concatenate to length of 4000 bytes
a& = a& + 1 ' which is length of memo text displayable
END IF ' in dBASE MODIFY COMMAND editor